SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00005 1 08-24-9413:27ALL JUAN JOSE VERGARA TSR SWAG9408 è╠ç┬ 11 /Å π{ This TSR, when press Crtl+Print Screen save to disk the screen. }π{Antonio Moro's routines, from Spain TP Echo}π{$M 1024, 0, 0} (* 1 K for Stack *)π{$S-}πPROGRAM Caza;πUSES Dos, Crt;πVAR numfichero : Byte;π fichero : File;π s_num, drive : String [2];π buffg : Pointer;ππPROCEDURE Graba (Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);πINTERRUPT;π Beginπ Str(numfichero,s_num);π Inc(numfichero);π Assign(fichero, drive + 'SCREEN.' + s_num);π Rewrite(fichero,1);π buffg:= Ptr($B000,0); (* Hercules video memory direction *)π BlockWrite(fichero,buffg^,32768); (* save 32K block of video memory π in a file*)π Close(fichero);π End;ππBEGINπ If ParamCount = 1 Then drive:=ParamStr(1) + ':'π Else drive:='C:';π Writeln;π HighVideo;π Writeln('Resident Savescreen.');π Write('For activate press SHIFT + PRTSCR');π LowVideo;π Writeln;π numfichero:=0;π SetINtVec(5, @Graba); (* Change interrupt vector of 5 interruptionπ (print screen) *) π Keep(0); (* End and Stay Resident *)ππEND.π 2 08-24-9413:41ALL ALWIN LOECKX Grab A $13-Image TSR SWAG9408 {e\$ 11 /Å π{$m $800,0,0 }ππprogram catch; { just for Swag }ππuses crt, dos;ππconst header : array[1..2] of word = (320, 200);ππvar cnt : byte;ππ{$f+}πprocedure new_int; interrupt;ππvar imgfile : file;π imgname : string[12];ππbeginπ str(cnt, imgname);π if cnt < 10 then imgname := '0'+imgname;π if cnt < 100 then imgname := '0'+imgname;π imgname := 'grab.'+imgname;ππ {$i-}π assign(imgfile, imgname);π rewrite(imgfile, 1);ππ blockwrite(imgfile, header, 4);π blockwrite(imgfile, mem[$a000:$0], 320*200);ππ close(imgfile);π {$i+}ππ if ioresult <> 0 thenπ beginπ sound(1000); { Error }π delay(1000);π nosound;π endπ elseπ beginπ sound(50); { Ok! }π delay(50);π nosound;π inc(cnt);π end;πend;π{$f-}πππbeginπ cnt := 1;ππ setintvec($5, addr(new_int));ππ writeln('Press Screen Print to grab a 320x200x256 image to "grab.###"');π writeln('One short low beep means "No error", a long high one means trouble');π writeln;π writeln('Only catch when you''re sure:');π writeln('∙Your hard-disk is not busy');π writeln('∙You''re in a program (so not at the command-prompt)');π writeln('∙You''re in the mcga 320x200 256 color modus ($13)');ππ keep(0);πend.ππWarning!πDo NOT run this program from within Tp!πJust compile it, then run it as an executable.π 3 08-24-9413:44ALL LUIS MEZQUITA Tsr's In Turbo Pascal SWAG9408 ╕┬£ 11 /Å Program TSR;ππ{ TSR Demo }π{ (c) Jul 94 Luis Mezquita Raya }ππ{$M $1000,0,0}ππuses Crt,Dos;ππvar OldInt09h:procedure;ππProcedure EndTSR; assembler;πasmπ cliπ mov AH,49hπ mov ES,PrefixSegπ push ESπ mov ES,ES:[2Ch]π int 21hπ pop ESπ mov AH,49hπ int 21hπ stiπend;ππ{$f+}πProcedure NewInt09h; interrupt;πvar k:byte; kb_exit:boolean;πbeginπ k:=Port[$60];π kb_exit:=False;π if k<$80π then beginπ Sound(5000);π Delay(1);π NoSound;π endπ else if k=$CE { $4E or $80 }π then kb_exit:=True;π asm pushf end;π OldInt09h;π if kb_exitπ then beginπ Sound(440);π Delay(15);π NoSound;π SetIntVec(9,@OldInt09h);π EndTSR;π end;πend;π{$f-}ππbeginπ GetIntVec(9,@OldInt09h);π SetIntVec(9,@NewInt09h);π Keep(0);πend.π>--- cut here -----------------------------------------------------ππ When you run this program you get a key-click each time youπpress a key but TSR program discharges if you press the big '+' keyπ(at numeric keyboard).ππ Greetings,π Luisππ 4 08-24-9413:56ALL JUAN JOSE VERGARA TSR Screen Saver SWAG9408 ë²■ 12 /Å {This is a Screen saver, that passed X time blank screen if no pressed a Key}ππ{ - TSR.PAS - }ππ{$M 6000,0,0}π{$R-,S-,I-,D+,F+,V-,B-,N-,L+}ππUses Dos,Crt,Graph,Screen;π{ The code for SCREEN.PAS is in the SCREEN.SWG file }πConstπ KeyBdInt = $09;π TimerInt = $08;π ScreenOn:Boolean = True;π Seconds = 10; {Time to activate}π Counter:Word = 0;πVarπ Regs:Registers;π OldKbdVec,OldTimerVec:Pointer;π S:ScreenStore;πProcedure STI; Inline($FB);πProcedure CLI; Inline($FA);πProcedure CallOldInt(Sub:Pointer);π Beginπ Inline($9C/$FF/$5E/$06);π End;πProcedure KeyBoard(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word); Interrupt;π Beginπ Counter:=0;π If Not(ScreenOn) Thenπ Beginπ S.RestoreScreen;π ScreenOn:=True;π End;π CallOldInt(OldKbdVec);π STI;π End;πProcedure Timer(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word); Interrupt;π Beginπ If ScreenOn Thenπ Beginπ Inc(Counter);π If Counter>(Trunc(18.2*Seconds)) Thenπ Beginπ S.StoreScreen;π ClrScr;π ScreenOn:=False;π End;π End;π CallOldInt(OldTimerVec);π STI;π End;πBeginπS.Init(1,1,178,7);πGetIntVec(KeyBdInt,OldKbdVec);πSetIntVec(KeyBdInt,@KeyBoard);πGetIntVec(TimerInt,OldTimerVec);πSetIntVec(TimerInt,@Timer);πKeep(0);ππEnd.π 5 08-25-9409:11ALL ERIK ANDERSON Screen Scrool TSR SWAG9408 ªw∞▀ 49 /Å {π>Basically a function that allows me to have 3 lines at the top non scrollablπ>(that I can change, the content of the lines), but so the stuff underthemπ>scrolles...ππWell, when you don't like the way the BIOS scrolls the screen, changeπthe BIOS!ππHere's an interesting program that I just wrote for this purpose. Itπinstalls a TSR-like program that interferes with the BIOS scroll-upπroutine and forces the top to be a variable you set.ππWhile debugging the program, I ran into a bit of trouble with the wayπthat TP handles interrupts. If you notice, half of the ISR has turnedπinto restoring the registers that TP trashes!π}πUses Dos, Crt; {Crt only used by main pgm}ππvarπ TopLine : byte;π OldInt : Procedure;ππ{Procedure Catch is the actual ISR, filtering out BIOS SCROLL-UP commands, andπ forcing the top of the scroll to be the value [TopLine] }ππ{$F+}πprocedure Catch(Flags, rCS, rIP, rAX, rBX, rCX, rDX, rSI, rDI, rDS, rES, rBP: Word); Interrupt;π{ Procedure Catch; interrupt;}π begin {Catch}π asmπ MOV AX, Flagsπ SAHFπ MOV AX, rAXπ MOV BX, rBXπ MOV CX, rCXπ MOV DX, rDXπ MOV SI, rSIπ MOV DI, rDIπ CMP AH, 06π JNE @Passπ CMP CH, TopLineπ JA @Passπ MOV CH, TopLineππ@Pass:π end;π OldInt; {Pass through to old handler}π asmπ MOV rAX, AXπ MOV rBX, BXπ MOV rCX, CXπ MOV rDX, DXπ MOV rSI, SIπ MOV rDI, DIπ end;π end; {Catch}π{$F-}ππ Procedure Install;π beginπ GetIntVec($10, Addr(OldInt));π SetIntVec($10, Addr(Catch));π end;ππ Procedure DeInstall;π beginπ SetIntVec($10, Addr(OldInt));π end;ππbeginπ ClrScr;π DirectVideo := TRUE;π TopLine := 5; {Keep 5+1 lines at top of screen}π Install;π while true do readln;πend.ππ{π>p.p.s I also need a routine (preferably in Turbo Pascal 7 ASM) that saves tπ> content of the current screen in an ANSI file on the disk. I saw oneπ> a while ago in SWAG, but I can't seem to find it now (I'm a dist siteπ> but still can't find it).ππAlso, since I didn't have anything better to do, I sat down and did aπversion of your screen->ANSI. It's rather primitive... it does a 80x24πdump with auto-EOLn seensing, does no CRLF if the line is 80 chars longπ(relies on screen wrap) and no macroing. If you want to, you can addπmacroing, which replaces a number of spaces with a single ANSI 'setπcursor' command. Well, here goes...ππ}π Procedure Xlate(var OutFile : text); {by Erik Anderson}π {The screen is basically an array of elements, each element containing oneπ a one-byte character and a one-byte color attribute}π constπ NUMROWS = 25;π NUMCOLS = 80;π typeπ ElementType = recordπ ch : char;π Attr : byte;π end;π ScreenType = array[1..NUMROWS,1..NUMCOLS] of ElementType;ππ {The Attribute is structured as follows:π bit 0: foreground blue elementπ bit 1: " green elementπ bit 2: " red elementπ bit 3: high intensity flagπ bit 4: background blue elementπ bit 5: " green elementπ bit 6: " red elementπ bit 7: flash flagππ The following constant masks help the program acess different partsπ of the attribute}π constπ TextMask = $07; {0000 0111}π BoldMask = $08; {0000 1000}π BackMask = $70; {0111 0000}π FlshMask = $80; {1000 0000}π BackShft = 4;ππ ESC = #$1B;ππ {ANSI colors are not the same as IBM colors... this table fixes theπ discrepancy:}π ANSIcolors : array[0..7] of byte = (0, 4, 2, 6, 1, 5, 3, 7);ππ {This procedure sends the new attribute to the ANSI dump file}π Procedure ChangeAttr(var Outfile : text; var OldAtr : byte; NewAtr : byte);π varπ Connect : string[1]; {Is a seperator needed?}π beginπ Connect := '';π write(Outfile, ESC, '['); {Begin sequence}π If (OldAtr AND (BoldMask+FlshMask)) <> {Output flash & blink}π (NewAtr AND (BoldMask+FlshMask)) then beginπ write(Outfile, '0');π If NewAtr AND BoldMask <> 0 then write(Outfile, ';1');π If NewAtr AND FlshMask <> 0 then write(Outfile, ';5');π OldAtr := $FF; Connect := ';'; {Force other attr's to print}π end;ππ If OldAtr AND BackMask <> NewAtr AND BackMask then beginπ write(OutFile, Connect,π ANSIcolors[(NewAtr AND BackMask) shr BackShft] + 40);π Connect := ';';π end;ππ If OldAtr AND TextMask <> NewAtr AND TextMask then beginπ write(OutFile, Connect,π ANSIcolors[NewAtr AND TextMask] + 30);π end;ππ write(outfile, 'm'); {Terminate sequence}π OldAtr := NewAtr;π end;ππ {Does this character need a changing of the attribute? If it is a space,π then only the background color matters}ππ Function AttrChanged(Attr : byte; ThisEl : ElementType) : boolean;π varπ Result : boolean;π beginπ Result := FALSE;π If ThisEl.ch = ' ' then beginπ If ThisEl.Attr AND BackMask <> Attr AND BackMask thenπ Result := TRUE;π end else beginπ If ThisEl.Attr <> Attr then Result := TRUE;π end;π AttrChanged := Result;π end;ππ varπ Screen : ScreenType absolute $b800:0000;π ThisAttr, TestAttr : byte;π LoopRow, LoopCol, LineLen : integer;π begin {Xlate}π ThisAttr := $FF; {Force attribute to be set}π For LoopRow := 1 to NUMROWS do beginππ LineLen := NUMCOLS; {Find length of line}π While (LineLen > 0) and (Screen[LoopRow, LineLen].ch = ' ')π and not AttrChanged($00, Screen[LoopRow, LineLen])π do Dec(LineLen);ππ For LoopCol := 1 to LineLen do begin {Send stream to file}π If AttrChanged(ThisAttr, Screen[LoopRow, LoopCol])π then ChangeAttr(Outfile, ThisAttr, Screen[LoopRow, LoopCol].Attr);π write(Outfile, Screen[LoopRow, LoopCol].ch);π end;π If LineLen < 80 then writeln(OutFile); {else wraparound occurs}π end;π end; {Xlate}ππvarπ OutFile : text;πbeginπ Assign(OutFile, 'dump.scn');π Rewrite(OutFile);π Xlate(OUtFile);π Close(OUtFile);πend.π
